InfoMagic Internet Tools 1995 April/Internet Tools.iso/mail/listserv/utils/iul2mosaic-gate.pl.Z/iul2mosaic-gate.pl

Perl Script | 1994-09-07 | 6.4 KB | 205 lines

#!/usr/local/bin/perl
#I'm posting this CGI script, as a first cut of an interface from Mosaic/Lynx
#to listproc. Modify the variables in the beginning of the script to suit you,
#and put it in your cgi-bin directory on your web server. Create an HREF in
#the home page, to the script, and you should be ready to go.
#
#You also need to have IUL ported to your web server.
#
#Any ideas and improvements are very welcome ([e-mail]).
#
#For V2, I'm thinking of adding an administrative page, and more commands.
#
# Copyright (c) 1994 Per Reedtz Thomsen ([e-mail]).
#
#
# Iul-gate is free software; you can redistribute it and/or modify
# it as long as you do not in any way modify the Copyright notices
# in this file.
#
# Iul-gate is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# No warranty is given for the useability of this software for any
# purposes whatsoever. If it's useful to you, good; if not, tough!
#
# Author: [e-mail] (Per Reedtz Thomsen)
#
# Major contributions (and polishing): Hubert Shaw
#
# History:
#        09/08/94    pthomsen    Genericized
#               09/08/94        hshaw           Fixed footers for 'gets'
#               09/07/94        hshaw           Fixed to work on hps737
#               08/29/94        pthomsen    Created.
#

format top =
<pre>Name                                    Size   Description</pre><hr>
.
format STDOUT =
<pre>@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<@@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<  @>>>>>>   @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< </pre>
$ref,$hack,$name,                            $size,    $description
.

# Set up the query received from httpd.
@querya    = @ARGV;

# ================================================
# Modify these 6 variables, to set up your config.
# ================================================
$lsadmin   = "Per Thomsen ([e-mail])";  # The ListServ administrator
$cgiadmin  = "Foo Bar ([e-mail])";        # The cgi (or http) administrator
$basetitle = "Power Products Division Archives";      # The beginning of the title string
$iul       = "/usr/local/etc/httpd/bin/iul";          # Full path of the IUL executable
$host      = "gravity";                               # The host to connect to
$footer    = "<hr>\n<ADDRESS>The 'oracle4u' List Server is maintained by $lsadmin</ADDRESS>\n";
                                                      # This will be at the bottom of every page
$bmapoff   = "   ";

if (@querya <= 1)
{
  $query     = "index";
  $keywd     = "index";
  $idxpath   = "ListServ";
  # =======================================================================
  # The $introtext variable can also be edited, to say whatever you need...
  # =======================================================================
  $introtext = "<h1>$basetitle</h1><p>
This HTML page gives access to the 'oracle4u' List Server archives. These archives are also available via email.<p>
<ADDRESS>Contact $lsadmin for more information on List Server.</ADDRESS><p>
<ADDRESS>Contact $cgiadmin if you have problems with this interface.</ADDRESS><hr>";
}
else
{
  $query     = join(" ", @querya);
  $keywd     = @querya[0];
  $idxpath   = @querya[1];
  $introtext = "";
}

if ($keywd eq "get")
{
  $title = "<title>$basetitle ($idxpath): @querya[2]</title>\n";
}
else
{
  $title = "<title>$basetitle ($idxpath)</title>\n";
}

# Name of files containing IUL input/output
$cmdfile = "/tmp/iulcmd.$$";
$outfile = "/tmp/iulout.$$";

# Create a file full of commands to be run by IUL
open(COMMANDS, "> $cmdfile") || die "Can't open temp command file\n";
print COMMANDS "\n$query > $outfile\nquit\n";
close COMMANDS;

# Run IUL with the command file
open(IUL, "$iul $host < $cmdfile |") || die "IUL didn't run\n";
while (<IUL>) {}
close IUL;
unlink $cmdfile;


open(IUL, "< $outfile") || die "cannot retrieve IUL output\n";

# Print out HTML id
print "Content-type: text/html\n";
print "\n";
print $title;
print $introtext;

if ($keywd eq "index")
{
  while (<IUL>)
  {
    if (/^Archive:/)
    { # handle archives
      $archname = $_;
      $archname =~ s/.*path: (.*)\).*/\1/;
      chop $archname;
      while (<IUL>)
      {
    last if (/^$/);              # No more files in this archive
        chop $_;
        if (/.*part.*bytes.*/)
        { # handle files
          if (/.*--.*/)
          {
            ($fileinfo,$filedes) = split("--");
          }
          else
          {
            $fileinfo = $_;
            $filedes  = "(no description available)";
          }
          local($filename,$sizeinfo) = ($fileinfo,$fileinfo);
          $filename =~ s/[ ]*(.*)[ ]*\(.*\).*/\1/;
          chop $filename;
          $ref      =  "<img align=bottom src=/icons/text.xbm alt=\"   \"> <a href=iul-gate.pl?get+$archname+$filename";
          $hack     =  ">";
          $name     =  $filename . "</a>";
          $sizeinfo =~ s/.*\((.*)\).*/\1/;
          $sizeinfo =~ s/{parts|,|bytes}//;
          @sizes = split(' ', $sizeinfo);
          for ($pt = @sizes[0], $size = 0; @sizes;)
          {
            shift @sizes;
            $size += @sizes[0];
          }
          $description = $filedes;
          $description =~ s/^[ \t]*(.*)/\1/;
          write;
        }
        else
        { # handle extra lines of description
          chop;
          $ref   = "<!-";
          $hack  = ">";
          $name  = "<!->";
          $size  = "";
          $pt    = "";
          $description = $_;
          $description =~ s/^[ \t]*(.*)/\1/;
          $description = $bmapoff . $description;
          write;
        }
      }
    }
    elsif (/^Subarchive:/)
    { # handle subarchives
      local($archname,$archpath) = ($_,$_);
      $archname =~ s/^Subarchive: (.*)[ ]\(.*\).*/\1/;
      chop $archname;
      $archpath =~ s/.*\(path: (.*)\).*/\1/;
      chop $archpath;
      $ref   = "<img align=bottom src=/icons/menu.xbm alt=\"   \"> <a href=iul-gate.pl?index+$archpath";
      $hack  = ">";
      $name  = $archname . "</a>";
      $size  = "";
      $pt    = "";
      $description = "[Subarchive - $archpath]";
      write;
    }
  }
}
elsif ($keywd eq "get")
{
  print "<pre>\n";
  while (<IUL>)
  {
    print;
  }
  print "</pre>\n";
}

# Print contact info.
print $footer;

close  IUL;
unlink $outfile;